home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 February / EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso / earcd / faq / kjvcbibl.lha / cbible / rexx / changeblk.thnkr < prev    next >
Text File  |  1993-03-18  |  2KB  |  44 lines
  1. /******************************************************************
  2. *                                                                 *
  3. *  Macro to change all occurrences of '  ' to ' '                 *
  4. *                                                                 *
  5. *    Also illustrates a way to visit every statement in the       *
  6. *    hierachy of statements.  REPBLK might be some other          *
  7. *    suitable processing of each statement                        *
  8. *                                                                 *
  9. ******************************************************************/
  10. trace off
  11. options results
  12.  
  13. get origin                                  /* start here */
  14. repblk(result)                              /* strip out blanks */
  15.  do forever                     /* end condition detected within */
  16.     position save 1             /* save good position */
  17.     get down                    /* get subordinate statement */
  18.     if rc ~= 0 then do          /*  opps no more down (at bottom) */
  19.         postion restore 1       /* restore last good postion */
  20.         get succeeding          /* get successor from there */
  21.         if rc ~= 0 then do      /*  opps no more, must go UP */
  22.             do forever              /* start walking up */
  23.                 position restore 1  /* restore last good postion */
  24.                 get up              /* get UP from there */
  25.                 if rc ~= 0 then exit 0  /* NO UP. Then at very end */
  26.                 position save 1     /* yes, save this as good postion */
  27.                 get succeeding      /* get successor from UP */
  28.                 if rc=0 then leave  /* if good then continue, else */
  29.                                     /* continue UP till find one */
  30.             end
  31.         end
  32.      end
  33.      repblk(result)                 /* have a statement */
  34.  end
  35. end
  36. /********************************************************************
  37.   procedure to strip redundant blanks from a statement and update
  38. ********************************************************************/
  39. repblk: procedure
  40.     parse arg str
  41.     update current space(str,1)
  42.     return 0
  43. end
  44.